Rapport statistique
MUTAMU TONY DASSIN
15/11/2021
Ces données proviennent de Break Free from Plastic et sont fournies par Sarah Sauve. Elles illustrent les différentes émissions de plastiques de certains pays , leurs sources et les actions apportées.
Sarah a rédigé un blogue sur son approche de ces données, qui comprend le nettoyage des données et une application Shiny . Elle a découvert les audits de marque de “Break Free From Plastic” en s’impliquant dans la “Social Justice Cooperative of Newfoundland” and “Labrador’s Zero Waste Action Team”. Elle a téléchargé les données brutes de son Google Drive, et a pu rédiger un court script de nettoyage et de jointure des données.
Installation des packages “tidyverse” , “tidytuesdayR” et " dlpyr"
#install.packages("tidytuesdayR")
#install.packages("tidyverse")
#install.packages("dlpyr")Lancement de la library “tidyverse” ,“tidytuesdayR” et “kableExtra” et récupération des données
library(tidytuesdayR)
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.4 v dplyr 1.0.7
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 2.0.1 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(kableExtra)##
## Attachement du package : 'kableExtra'## L'objet suivant est masqué depuis 'package:dplyr':
##
## group_rowslibrary(dplyr)
plastics <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-01-26/plastics.csv')## Rows: 13380 Columns: 14## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (2): country, parent_company
## dbl (12): year, empty, hdpe, ldpe, o, pet, pp, ps, pvc, grand_total, num_eve...##
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.Code de fusion des bases données
library(fs)
files_2020 <- fs::dir_ls(“2020 BFFP National Data Results”) %>% str_subset(“csv”)
files_2019 <- fs::dir_ls(“2019 Brand Audit Appendix _ Results by Country/Countries”) %>% str_subset(“csv”)
data_2020 <- files_2020 %>% map_dfr(read_csv, col_types = cols( Country = col_character(), Parent_company = col_character(), Empty = col_double(), HDPE = col_double(), LDPE = col_double(), O = col_double(), PET = col_double(), PP = col_double(), PS = col_double(), PVC = col_double(), Grand_Total = col_character(), num_events = col_double(), volunteers = col_double() )) %>% mutate(year = 2020, .after = Country) %>% mutate(Grand_Total = parse_number(Grand_Total)) %>% janitor::clean_names()
data_2019 <- files_2019 %>% set_names(str_replace(., “./[.].”, “\1”)) %>% map_dfr(read_csv, .id = “country”, col_types = cols( Country = col_character(), Parent_company = col_character(), Empty = col_double(), HDPE = col_double(), LDPE = col_double(), O = col_double(), PET = col_double(), PP = col_double(), PS = col_double(), PVC = col_double(), Grand_Total = col_double(), num_events = col_double(), volunteers = col_double() )) %>% select(country, everything()) %>% mutate(year = 2019, .after = country) %>% janitor::clean_names() %>% mutate(pp = if_else(is.na(pp_2), pp, pp_2 + pp), ps = if_else(is.na(ps_2), ps, ps + ps_2)) %>% rename(parent_company = parent_co_final, num_events = number_of_events, volunteers= number_of_volunteers) %>% select(-ps_2, -pp_2)
combo_data <- bind_rows(data_2019, data_2020)
combo_data %>% write_csv(“2021/2021-01-26/plastics.csv”)
Nettoyage de la base de données
Présentation des Variables
Renommage des variables non-explicites
plastics <- plastics %>%
rename( Pays = country ,Année = year, Source_plastic = parent_company , Cat_vide= empty, Cat_autre= o ,Polyester= pet , Polypropylene = pp ,Polystyrene = ps , Nombre_even = num_events , Volontaires = volunteers )Eliminations des doublons
keyval <- data.frame(Pays = c("United Kingdom of Great Britain & Northern Ireland","NIGERIA","Nigeria","ECUADOR"),
val = c("United Kingdom","Nigéria","Nigéria","Ecuador"), stringsAsFactors = FALSE)
plastics<-plastics%>%
left_join(keyval) %>%
mutate(Pays= coalesce(val,Pays)) %>%
select(-val) %>%
filter( Pays != "EMPTY")## Joining, by = "Pays"Omission des valeurs manquantes de la base de données
plastique <- na.omit(plastics)Présence de plusieurs variables manquantes. Usage de la fonction de “na.omit”.
Nous passons de 12034 à 6826 observations
Statistiques descriptives
summary(plastique)## Pays Année Source_plastic Cat_vide
## Length:6826 Min. :2019 Length:6826 Min. : 0.0000
## Class :character 1st Qu.:2019 Class :character 1st Qu.: 0.0000
## Mode :character Median :2020 Mode :character Median : 0.0000
## Mean :2020 Mean : 0.6109
## 3rd Qu.:2020 3rd Qu.: 0.0000
## Max. :2020 Max. :2208.0000
## hdpe ldpe Cat_autre Polyester
## Min. : 0.000 Min. : 0.00 Min. : 0.0 Min. : 0.00
## 1st Qu.: 0.000 1st Qu.: 0.00 1st Qu.: 0.0 1st Qu.: 0.00
## Median : 0.000 Median : 0.00 Median : 0.0 Median : 0.00
## Mean : 4.147 Mean : 13.09 Mean : 36.4 Mean : 26.43
## 3rd Qu.: 0.000 3rd Qu.: 0.00 3rd Qu.: 2.0 3rd Qu.: 1.00
## Max. :3728.000 Max. :11700.00 Max. :28055.0 Max. :36226.00
## Polypropylene Polystyrene pvc grand_total
## Min. : 0.00 Min. : 0.000 Min. : 0.0000 Min. : 0.00
## 1st Qu.: 0.00 1st Qu.: 0.000 1st Qu.: 0.0000 1st Qu.: 1.00
## Median : 0.00 Median : 0.000 Median : 0.0000 Median : 2.00
## Mean : 10.19 Mean : 2.197 Mean : 0.3857 Mean : 93.45
## 3rd Qu.: 0.00 3rd Qu.: 0.000 3rd Qu.: 0.0000 3rd Qu.: 8.00
## Max. :6046.00 Max. :1390.000 Max. :622.0000 Max. :80570.00
## Nombre_even Volontaires
## Min. : 1.00 Min. : 3
## 1st Qu.: 4.00 1st Qu.: 190
## Median : 17.00 Median : 400
## Mean : 24.11 Mean :1477
## 3rd Qu.: 32.00 3rd Qu.:2099
## Max. :134.00 Max. :6850names(plastique)## [1] "Pays" "Année" "Source_plastic" "Cat_vide"
## [5] "hdpe" "ldpe" "Cat_autre" "Polyester"
## [9] "Polypropylene" "Polystyrene" "pvc" "grand_total"
## [13] "Nombre_even" "Volontaires"dim(plastique)## [1] 6826 14Questions
1. Pour chaque type de plastique , le pays qui en pollue le plus ?
Lancement de la library “ggplot2”
library(ggplot2)hdpe
plastique %>%
group_by(Pays) %>%
ggplot()+
aes(x= hdpe, y=Pays)+
geom_bar(stat='identity' , fill="red")
=>Le nigéria a pollué le plus en hdpe
ldpe
plastique %>%
group_by(Pays) %>%
ggplot()+
aes(x= ldpe, y=Pays)+
geom_bar(stat='identity',fill="orange")
=> Le nigéria a pollué le plus en ldpe
Polyester
plastique %>%
group_by(Pays) %>%
ggplot()+
aes(x= Polyester , y=Pays)+
geom_bar(stat='identity', fill="purple")
=> Le nigéria a pollué le plus en Polyester
Polypropylene
plastique %>%
group_by(Pays) %>%
ggplot()+
aes(x= Polypropylene , y=Pays)+
geom_bar(stat='identity', fill= "dark green")
=> Les philippines ont polué le plus en Polypropylène
On peut aussi mettre comme filler la variable “Année” . De ce fait nous pourrons repondre à des questions tels ques : - Pour chaque pays , l’année où il a poluer le plus le type de plastique dont il est question.
Polystyrene
plastique %>%
group_by(Pays) %>%
ggplot()+
aes(x= Polystyrene , y=Pays)+
geom_bar(stat='identity',aes(fill= Année) )
On remarque que l’indonésie qui est au top du classement des pollueurs de polystyrène à beaucoup plus poluer en 2019 qu’en 2020.
pvc
plastique %>%
group_by(Pays) %>%
ggplot()+
aes(x= pvc , y=Pays)+
geom_bar(stat='identity',aes(fill= Année))
2.Quel pays pollue le plus en plastique en générale en 2019 ?
plastique %>%
filter(Année=="2019") %>%
group_by(Pays) %>%
ggplot()+
aes(x= grand_total, y=Pays)+
geom_bar(stat='identity',aes(fill= Année))+labs(title = "Répartition de la pollution de plastique en 2019 ", x="Totale de plastique pollué") 
Le nigéria est le pays qui a le plus polluer en plastique en 2019
3.Quel pays pollue le plus en plastique en générale en 2020 ?
plastique %>%
filter(Année=="2020") %>%
group_by(Pays) %>%
ggplot()+
aes(x= grand_total, y=Pays)+
geom_bar(stat='identity',aes(fill= Année))+labs(title = "Répartition de la pollution de plastique en 2019 ", x="Totale de plastique pollué") 
=> Le nigéria est le pays qui a le plus polluer en plastique en 2020
4. Combien y’a t’il d’évenements et de volontaires par an pour chaque pays ?
NBP<- plastique %>%
as_tibble() %>%
count(Pays,Année,Volontaires, Nombre_even)
knitr::kable(head(NBP [1:5]), "simple")| Pays | Année | Volontaires | Nombre_even | n |
|---|---|---|---|---|
| Argentina | 2019 | 243 | 4 | 275 |
| Argentina | 2020 | 9 | 24 | 226 |
| Armenia | 2020 | 6 | 2 | 2 |
| Australia | 2020 | 190 | 9 | 69 |
| Bangladesh | 2020 | 127 | 1 | 142 |
| Benin | 2020 | 458 | 2 | 2 |
NBP %>%
group_by(Pays) %>%
ggplot()+
aes(x=Pays , y=Volontaires)+
geom_bar(stat='identity', fill="green")+coord_flip()+
labs(title = "Répartition du nombre de volontaires par pays ")
NBP %>%
group_by(Pays) %>%
ggplot()+
aes(x=Pays , y=Nombre_even)+
geom_bar(stat='identity', fill="dark green")+coord_flip()+
labs(title = "Répartition du nombre d'évènements par pays ")
Création de la sous-table “NBP” contenant les variables “Pays”, “Année”, “Volontaires”et “Nombre_even” dans le but de simplifier la visualisation des réprésentations graphiques.
On peut donc répurérer facilement les résultats.
Les deux graphiques précédents permettre de repondre aux questions :
- Quel est le pays avec le plus d’évènements ?
- Quel est le pays avec le plus de volontaires ? -En quelle année, y’a t’il eu le plus de volontaires / évènements ?
5. Combien y’a t’il de sources de plastique pour chaque pays ?
NBS<- plastique %>%
as_tibble() %>%
count(Pays,Source_plastic) %>%
group_by(Pays)
NBS## # A tibble: 6,645 x 3
## # Groups: Pays [54]
## Pays Source_plastic n
## <chr> <chr> <int>
## 1 Argentina 9 De Oro 1
## 2 Argentina Aceitera Martinez S.A 1
## 3 Argentina Acivag 1
## 4 Argentina Adidas 1
## 5 Argentina AGD 1
## 6 Argentina Agua Bes 1
## 7 Argentina Agua De La Costa 1
## 8 Argentina Agua de las misiones 1
## 9 Argentina Agua De Las Misiones 1
## 10 Argentina Ala 1
## # ... with 6,635 more rowsCette question nous fait réalisée que la variable “Source_plastic” ne peut être d’une grande utilité dans le traitement de nos données au regard de son unicité. La sous-table créée servira à repondre à des questions comme “le nombre de source de plastique d’un pays”.
6.Pour quels pays avons-nous des données pour 2019 et 2020 ?
NBP %>%
filter(Année == "2019")## # A tibble: 6 x 5
## Pays Année Volontaires Nombre_even n
## <chr> <dbl> <dbl> <dbl> <int>
## 1 Argentina 2019 243 4 275
## 2 India 2019 88 4 209
## 3 Indonesia 2019 6850 32 636
## 4 Nigéria 2019 1648 14 354
## 5 Philippines 2019 3751 20 711
## 6 Vietnam 2019 400 4 678NBP %>%
filter(Année == "2020")## # A tibble: 54 x 5
## Pays Année Volontaires Nombre_even n
## <chr> <dbl> <dbl> <dbl> <int>
## 1 Argentina 2020 9 24 226
## 2 Armenia 2020 6 2 2
## 3 Australia 2020 190 9 69
## 4 Bangladesh 2020 127 1 142
## 5 Benin 2020 458 2 2
## 6 Brazil 2020 78 4 22
## 7 Bulgaria 2020 50 7 15
## 8 Burkina Faso 2020 163 1 15
## 9 Canada 2020 13 3 43
## 10 Chile 2020 13 3 121
## # ... with 44 more rowsNBP %>%
filter(Pays=="Argentina" | Pays == "India" | Pays == "Indonesia" | Pays == "Philippines" | Pays == "Vietnam" | Pays == "Nigéria")## # A tibble: 12 x 5
## Pays Année Volontaires Nombre_even n
## <chr> <dbl> <dbl> <dbl> <int>
## 1 Argentina 2019 243 4 275
## 2 Argentina 2020 9 24 226
## 3 India 2019 88 4 209
## 4 India 2020 353 56 348
## 5 Indonesia 2019 6850 32 636
## 6 Indonesia 2020 392 50 294
## 7 Nigéria 2019 1648 14 354
## 8 Nigéria 2020 2099 18 335
## 9 Philippines 2019 3751 20 711
## 10 Philippines 2020 915 17 120
## 11 Vietnam 2019 400 4 678
## 12 Vietnam 2020 27 6 128Il n’y a seulement qu’en Argentine, en Inde, en Indonésie, aux Philippines , au Nigéria et au Vietnam que nous avons des données sur les volontaires en 2019 ET en 2020. Etudions l’évolution du nombre de volontaires selon ces 5 pays.
7. Dans quel pays le taux de volontaires a augmenté de 2019 à 2020 ?
Raise1920 <- NBP %>%
group_by(Année) %>%
filter(Pays=="Argentina" | Pays == "India" | Pays == "Indonesia" | Pays == "Philippines" | Pays == "Vietnam"| Pays == "Nigéria") %>%
select(Pays, Année, Volontaires)
Raise1920 %>%
ggplot()+
aes(x=Année, y=Volontaires, fill=Pays)+
geom_col()+
labs(title = "Distributions des volontaires sur 2019 et 2020") 
Il n’y a seulement qu’en Inde et au Nigéria que le nombre de volontaires à augmenté.
9. Comment la pollution a évolué entre 2019 et 2020 pour ces 5 pays?
plastique %>%
group_by(Année) %>%
filter(Pays=="Argentina" | Pays == "India" | Pays == "Indonesia" | Pays == "Philippines" | Pays == "Vietnam"| Pays == "Nigéria") %>%
select(Pays, Année, grand_total) %>%
ggplot()+
(aes(x=Année, y = grand_total, fill=Pays))+
geom_col()+
labs(title = "Evolution de la pollution", x = "Année", y="degré de pollution") 
La pollution du Vietnam, des Philippines, du Nigéria , de l’Indonésie et de l’Argentine a diminué, tandis que celle de l’Inde à augmenté.
10. Quelle est la distribution de la variable “Pays” de la table Raise1920 sur le nombre de volontaires ?
Raise1920 %>%
ggplot()+
aes(x=Pays,y=Volontaires)+
geom_boxplot(varwidth=T, colour="purple",fill="yellow")+
labs(title = "Distribution des pays sur le nombre de volontaires") 
Le plus grand écart de distribution s’observe entre “l’Argentine” et “l’Indonésie”
11. Pour chaque pays, quelle est la distributon de la variable “Volontaires” de la table Raise1970 ?
Raise1920 %>%
group_by(Pays) %>%
ggplot()+
aes(x= Volontaires)+
geom_density(aes(fill=Pays), alpha=0.8) +
labs(title = "Distribution des volontaires") 
12. Y’aurait t’il une coorélation entre les volontaires et le pays de volontariat selon l’année ?
Raise1920 %>%
ggplot( ) +
aes(x=Pays, y = Volontaires, colour=Année)+
geom_point() +
geom_smooth(method="lm", se=F) ## `geom_smooth()` using formula 'y ~ x'
Section par Paolo Crosetto
Questions additionnelles
1. NAs
Vous avez éliminé la plupart de votre base parce qu’il y avait des données manquantes. Ceci peut être une bonne idéé, ou pas; et cela dépend de la nature de ces NAs. Vous risquez d’éliminer des observations où juste une variable que vous n’utilisez pas est manquante. Ou bien, les données sont codées de telle façon qu’un zéro est noté comme NA… et alors vous perdez de l’information.
Installez le package naniar, et regardez le tutoriel ici: https://cran.r-project.org/web/packages/naniar/vignettes/getting-started-w-naniar.html et essayez de visualiser les données manquantes.
Quelle est la donnée manquante la plus fréquente? Pourquoi les données sont-elles manquantes à votre avis?
A la lumière de ce que vous venez d’apprendre, cela a été une bonne idée d’éliminer les NAs?
Reponse :
#install.packages("naniar")
library(naniar)
#install.packages("visdat")
library(visdat)
vis_dat(plastics)
vis_miss(plastics)
# autres représentations de NA's
ggplot(plastics,
aes(x = hdpe,
y = pvc)) +
geom_miss_point()+
facet_wrap(~Année)+
theme_dark()
gg_miss_var(plastics, facet= Année) + theme_bw() ## Warning: It is deprecated to specify `guide = FALSE` to remove a guide. Please
## use `guide = "none"` instead.
La donnée manquante la plus fréquente est le plastique de type “pvc”. On constate aussi que l’année 2020 ne comporte pratiquement pas de données manquantes.
Lors de la jonction des différentes bases de données, on a tenu en compte que les différentes clés primaires qui sont les variables “Pays” , “Année”, “Source_plactic” . on a pas regardé les caractéristiques en termes de type de plastique polluer par chaque pays. Tous les pays ne rejettent pas tous les types de plastique. donc lorsque l’on join des differentes tables , on va nécessairement avoir des valeurs manquantes.
La méthode adoptée d’amputér toutes les lignes contenant des variables manquantes fut un peu radicale. Ce qu’on aurai pu faire est de calculer la proportion de valeurs maquantes par ligne et de supprimer les lignes avec un taux de valeurs manquantes supérieur à 30 %.
Dans celles avec un taux inférieur,on peut remplacer la valeur manquante par la moyenne de la colonne par exemple.
plastics %>%
add_prop_miss() %>%
head()## # A tibble: 6 x 15
## Pays Année Source_plastic Cat_vide hdpe ldpe Cat_autre Polyester
## <chr> <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Argentina 2019 Grand Total 0 215 55 607 1376
## 2 Argentina 2019 Unbranded 0 155 50 532 848
## 3 Argentina 2019 The Coca-Cola Company 0 0 0 0 222
## 4 Argentina 2019 Secco 0 0 0 0 39
## 5 Argentina 2019 Doble Cola 0 0 0 0 38
## 6 Argentina 2019 Pritty 0 0 0 0 22
## # ... with 7 more variables: Polypropylene <dbl>, Polystyrene <dbl>, pvc <dbl>,
## # grand_total <dbl>, Nombre_even <dbl>, Volontaires <dbl>,
## # prop_miss_all <dbl>2. Problèmes country
Il y a des problèmes avec la variable country, et notamment des noms doublons. Pourriez-vous les resoudre et de ce fait corriger votre .Rmd et tous ses résultas (hint: il n’y apas que le Nigeria qui est faux)
Réponse
Il y a eu des corrections dans la base de données sur la variable “Pays” entre autre sur les pays suivants : “United Kingdom” , “Nigéria” et " Ecuador " .
Il y a eu aussi la suppression de l’élément “EMPTY” de la variable pays .
Modification entre les lignes [ 116-127 ]
3. Q4: Dumbbell plot
Essayez de faire un dumbbell plot de l’évolution du nombre de volontaires par pays.
Il s’agit d’un plot dans ce style: https://static01.nyt.com/images/2021/03/24/multimedia/24-GENDER-EARNINGSGAP_RACE/24-GENDER-EARNINGSGAP_RACE-mobileMasterAt3x.png ou bien https://econlife.com/wp-content/uploads/2016/07/Dr__Paid_Less__An_Old_Title_Still_Fits_Female_Physicians_-_The_New_York_Times.png C’est à dire un “dotplot” qui montre pour chaque secteur (et sous-secteur) la différence homme/femme. Ce type de plots s’appellent aussi Dumbbell plots, examples ici: http://r-statistics.co/Top50-Ggplot2-Visualizations-MasterList-R-Code.html#3.%20Ranking
NBA <- plastics%>%
as_tibble() %>%
count(Pays,Année,Volontaires) %>%
pivot_wider(
names_from = Année ,
values_from = Volontaires,
id_cols = Pays,
names_prefix= "Année_")
NBA[is.na(NBA)] <- 0#install.packages("ggalt")
#devtools:: install_github("hrbrmstr/ggalt")
library(ggalt)## Warning: le package 'ggalt' a été compilé avec la version R 4.1.2## Registered S3 methods overwritten by 'ggalt':
## method from
## grid.draw.absoluteGrob ggplot2
## grobHeight.absoluteGrob ggplot2
## grobWidth.absoluteGrob ggplot2
## grobX.absoluteGrob ggplot2
## grobY.absoluteGrob ggplot2theme_set(theme_classic())NBA$Pays <- factor(NBA$Pays)
NBA %>%
ggplot(aes(x=Année_2019, xend=Année_2020, y=Pays, group=Pays ))+
geom_dumbbell(color="#a3c4dc",
colour_xend = "#0e668b",
size = 2.0,
dot_guide=TRUE,
dot_guide_size = 0.15,
dot_guide_colour = "grey60"
)+
labs (title = "L'évolution du nombre de volontaires par pays" , subtitle="Volonatires 2019 vs 2020",, x = "Volontaires" , y = "Pays " )+theme_classic() + theme(plot.title = element_text(hjust=0.5, face="bold") ,
plot.background=element_rect(fill="#f7f7f7"),
panel.background=element_rect(fill="#f7f7f7"),
panel.grid.minor=element_blank(),
panel.grid.major.y=element_blank(),
panel.grid.major.x=element_line(),
axis.ticks=element_blank(),
legend.position="top",
panel.border=element_blank())
8. Comment les evenements ont évolués entre 2019 et 2020 pour ces 5 pays?
Le nombre d’évènements de l’Argentine et de l’Inde ont fortement augementé, celui du Vietnam et du Nigéria légèrement, tandis que ceux de l’Indonésie et des Philippines ont legèrement diminué.